{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  HMinCaml.Assoc
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Beta reduction.
--
--------------------------------------------------------------------------------

module HMinCaml.Assoc
  (

    assoc

  ) where

import qualified HMinCaml.HMonad as H
import HMinCaml.KNormal


import Control.Applicative



--------------------------------------------------------------------------------
-- Reduce nested lets


type Mon a = H.HMonad a

assoc :: Expr -> H.HMonad Expr
assoc expr = ac expr


ac :: Expr -> Mon Expr
ac (IfEq x y e1 e2)         = IfEq x y <$> ac e1 <*> ac e2
ac (IfLE x y e1 e2)         = IfLE x y <$> ac e1 <*> ac e2
ac (Let xt e1 e2)           = ac e1 >>= insert
  where
    insert (Let yt e3 e4)     = Let yt e3 <$> ac e4
    insert (LetRec fds e)     = LetRec fds <$> insert e
    insert (LetTuple yts z e) = LetTuple yts z <$> insert e
    insert e                  = Let xt e <$> ac e2

ac (LetRec (Fundef (x,t) yts e1) e2) = do
    (\ea eb -> LetRec (Fundef (x,t) yts ea) eb) <$> ac e1 <*> ac e2

ac (LetTuple xts y e)       = LetTuple xts y <$> ac e
ac e                        = return e
